{-
  This library (deepseq) is derived from code from the GHC project which
  is largely (c) The University of Glasgow, and distributable under a
  BSD-style license (see below).
  It is adapted to work with Frege.

  -----------------------------------------------------------------------------

  The Glasgow Haskell Compiler License

  Copyright 2001-2009, The University Court of the University of Glasgow. 
  All rights reserved.

  Redistribution and use in source and binary forms, with or without
  modification, are permitted provided that the following conditions are met:

  - Redistributions of source code must retain the above copyright notice,
  this list of conditions and the following disclaimer.
   
  - Redistributions in binary form must reproduce the above copyright notice,
  this list of conditions and the following disclaimer in the documentation
  and/or other materials provided with the distribution.
   
  - Neither name of the University nor the names of its contributors may be
  used to endorse or promote products derived from this software without
  specific prior written permission. 

  THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF
  GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
  FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
  UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE
  FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
  CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH
  DAMAGE.

  -----------------------------------------------------------------------------
-}
{--
    This module provides an overloaded function, 'deepseq', for fully
    evaluating data structures (that is, evaluating to \"Normal Form\").

    'deepseq' differs from 'seq' as it traverses data structures deeply,
    for example, 'seq' will evaluate only to the first constructor in
    the list:

    > > [1,2,undefined] `seq` 3
    > 3

    While 'deepseq' will force evaluation of all the list elements:

    > > [1,2,undefined] `deepseq` 3
    > frege.runtime.Undefined: undefined

    Another common use is to ensure any exceptions hidden within lazy
    fields of a data structure do not leak outside the scope of the
    exception handler, or to force evaluation of a data structure in one
    thread, before passing to another thread (preventing work moving to
    the wrong threads).
-}
module Control.DeepSeq where

import Data.Tree

--- A class of types that can be fully evaluated.
class NFData α where
    --- 'rnf' should reduce its argument to normal form (that is, fully
    --- evaluate all sub-components), and then return '()'.
    rnf :: α -> ()
    rnf a = a `seq` ()

{--
    Fully evaluates @a@ and returns @b@.

    'deepseq': fully evaluates the first argument, before returning the
    second.

    The name 'deepseq' is used to illustrate the relationship to 'seq':
    where 'seq' is shallow in the sense that it only evaluates the top
    level of its argument, 'deepseq' traverses the entire data structure
    evaluating it completely.

    'deepseq' can be useful for forcing pending exceptions,
    eradicating space leaks, or forcing lazy I/O to happen.  It is
    also useful in conjunction with parallel Strategies (see the
    @parallel@ package).
-}
deepseq :: NFData α => α -> β -> β
deepseq a b = rnf a `seq` b

--- the deep analogue of '$!'.  In the expression @f $!! x@, @x@ is
--- fully evaluated before the function @f@ is applied to it.
---
($!!) :: (NFData α) => (α -> β) -> α -> β
f $!! x = x `deepseq` f x

{--
    a variant of 'deepseq' that is useful in some circumstances:

    > force x = x `deepseq` x

    @force x@ fully evaluates @x@, and then returns it.  Note that
    @force x@ only performs evaluation when the value of @force x@
    itself is demanded, so essentially it turns shallow evaluation into
    deep evaluation.
-}
force :: (NFData α) => α -> α
force x = x `deepseq` x

instance NFData Int
instance NFData Integer
instance NFData Long
instance NFData Float
instance NFData Double

instance NFData Char
instance NFData Bool
instance NFData ()

instance NFData String

instance NFData α => NFData (Maybe α) where
    rnf Nothing = ()
    rnf (Just x) = rnf x

instance (NFData α, NFData β) => NFData (Either α β) where
    rnf (Left x)  = rnf x
    rnf (Right x) = rnf x

instance NFData α => NFData [α] where
    rnf [] = ()
    rnf (x:xs) = case rnf x of
                    !_ -> rnf xs

instance NFData α => NFData (Tree α) where
    rnf (Node a b) = rnf a `seq` rnf b

--- This instance is for convenience and consistency with 'seq'.
--- This assumes that WHNF is equivalent to NF for functions.
---
instance NFData (a -> b) where
    rnf !_ = ()

----------------------------------------------------------------------------
-- Tuples

instance (NFData a, NFData b) => NFData (a,b) where
  rnf (x,y) = rnf x `seq` rnf y

instance (NFData a, NFData b, NFData c) => NFData (a,b,c) where
  rnf (x,y,z) = rnf x `seq` rnf y `seq` rnf z

instance (NFData a, NFData b, NFData c, NFData d) => NFData (a,b,c,d) where
  rnf (x1,x2,x3,x4) = rnf x1 `seq`
                      rnf x2 `seq`
                      rnf x3 `seq`
                      rnf x4

instance (NFData a1, NFData a2, NFData a3, NFData a4, NFData a5) =>
         NFData (a1, a2, a3, a4, a5) where
  rnf (x1, x2, x3, x4, x5) =
                  rnf x1 `seq`
                  rnf x2 `seq`
                  rnf x3 `seq`
                  rnf x4 `seq`
                  rnf x5

instance (NFData a1, NFData a2, NFData a3, NFData a4, NFData a5, NFData a6) =>
         NFData (a1, a2, a3, a4, a5, a6) where
  rnf (x1, x2, x3, x4, x5, x6) =
                  rnf x1 `seq`
                  rnf x2 `seq`
                  rnf x3 `seq`
                  rnf x4 `seq`
                  rnf x5 `seq`
                  rnf x6

instance (NFData a1, NFData a2, NFData a3, NFData a4, NFData a5, NFData a6, NFData a7) =>
         NFData (a1, a2, a3, a4, a5, a6, a7) where
  rnf (x1, x2, x3, x4, x5, x6, x7) =
                  rnf x1 `seq`
                  rnf x2 `seq`
                  rnf x3 `seq`
                  rnf x4 `seq`
                  rnf x5 `seq`
                  rnf x6 `seq`
                  rnf x7

instance (NFData a1, NFData a2, NFData a3, NFData a4, NFData a5, NFData a6, NFData a7, NFData a8) =>
         NFData (a1, a2, a3, a4, a5, a6, a7, a8) where
  rnf (x1, x2, x3, x4, x5, x6, x7, x8) =
                  rnf x1 `seq`
                  rnf x2 `seq`
                  rnf x3 `seq`
                  rnf x4 `seq`
                  rnf x5 `seq`
                  rnf x6 `seq`
                  rnf x7 `seq`
                  rnf x8

instance (NFData a1, NFData a2, NFData a3, NFData a4, NFData a5, NFData a6, NFData a7, NFData a8, NFData a9) =>
         NFData (a1, a2, a3, a4, a5, a6, a7, a8, a9) where
  rnf (x1, x2, x3, x4, x5, x6, x7, x8, x9) =
                  rnf x1 `seq`
                  rnf x2 `seq`
                  rnf x3 `seq`
                  rnf x4 `seq`
                  rnf x5 `seq`
                  rnf x6 `seq`
                  rnf x7 `seq`
                  rnf x8 `seq`
                  rnf x9
